home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 22 / Cream of the Crop 22.iso / program / ctlib100.zip / INSTALL.LZH / LISTS4.PAS < prev    next >
Pascal/Delphi Source File  |  1996-10-12  |  4KB  |  154 lines
  1. {**************************************************************************}
  2. {*  BitSoft Development, L.L.C.                                           *}
  3. {*  Copyright (C) 1995, 1996 BitSoft Development, L.L.C.                  *}
  4. {*  All rights reserved.                                                  *}
  5. {*  Containers Library demo                                               *}
  6. {**************************************************************************}
  7.  
  8. program Lists4;
  9.  
  10. {$X+}
  11.  
  12. { Sample program for using a sorted linked list. }
  13.  
  14. uses Objects, Containr, ctLists,
  15.      {$ifdef Windows}
  16.      WinCtr;
  17.      {$else}
  18.      Crt;
  19.      {$endif}
  20.  
  21. type
  22.   PContact = ^TContact;
  23.   TContact = object (TDoubleNode)
  24.       FirstName,
  25.       LastName,
  26.       Phone,
  27.       Company : PString;
  28.     constructor Init(ALastName, AFirstName, APhone, ACompany : string);
  29.     destructor Done; virtual;
  30.     function KeyOf : Pointer; virtual;
  31.   end; { TContact }
  32.  
  33. constructor TContact.Init(ALastName, AFirstName, APhone, ACompany : string);
  34. begin
  35.   TListNode.Init;
  36.   FirstName := NewStr(AFirstName);
  37.   LastName := NewStr(ALastName);
  38.   Phone := NewStr(APhone);
  39.   Company := NewStr(ACompany);
  40. end;
  41.  
  42. destructor TContact.Done;
  43. begin
  44.   DisposeStr(FirstName);
  45.   DisposeStr(LastName);
  46.   DisposeStr(Phone);
  47.   DisposeStr(Company);
  48.   TListNode.Done;
  49. end;
  50.  
  51. function TContact.KeyOf : Pointer;
  52. begin
  53.   KeyOf := LastName;
  54. end;
  55.  
  56. procedure DisplayContacts(ContactList : PSequence);
  57.  
  58.   procedure PrintInfo (Item : Pointer); far;
  59.   begin
  60.     with PContact(Item)^ do
  61.       writeln(LastName^, '':15 - Length(LastName^),
  62.         FirstName^, '':15 - Length(FirstName^),
  63.         Phone^, '':20 - Length(Phone^),
  64.         Company^, '':20 - Length(Company^));
  65.   end;
  66.  
  67. begin
  68.   ContactList^.ForEach(@PrintInfo);
  69. end;
  70.  
  71. procedure DisplayFirst(ContactList : PSequence);
  72. var
  73.   Item : Pointer;
  74.   Index : LongInt;
  75. begin
  76.   Item := ContactList^.First(Index);
  77.   Writeln('First item:');
  78.   with PContact(Item)^ do
  79.     writeln(LastName^, '':15 - Length(LastName^),
  80.       FirstName^, '':15 - Length(FirstName^),
  81.       Phone^, '':20 - Length(Phone^),
  82.       Company^, '':20 - Length(Company^));
  83.   ContactList^.DoneItem(Item); { not required }
  84. end;
  85.  
  86. procedure DisplayLast(ContactList : PSequence);
  87. var
  88.   Item : Pointer;
  89.   Index : LongInt;
  90. begin
  91.   Item := ContactList^.Last(Index);
  92.   Writeln('Last item:');
  93.   with PContact(Item)^ do
  94.     writeln(LastName^, '':15 - Length(LastName^),
  95.       FirstName^, '':15 - Length(FirstName^),
  96.       Phone^, '':20 - Length(Phone^),
  97.       Company^, '':20 - Length(Company^));
  98.   ContactList^.DoneItem(Item); { not required }
  99. end;
  100.  
  101. procedure FindLastName(ContactList : PSequence; LastName : string);
  102. var
  103.   Item : Pointer;
  104.   Index : LongInt;
  105.  
  106.   function MatchLastName (Item : Pointer): boolean; far;
  107.   begin
  108.     MatchLastName := (LastName = PContact(Item)^.LastName^);
  109.   end;
  110.  
  111. begin
  112.   Item := ContactList^.FirstThat(@MatchLastName, Index);
  113.   Writeln('Item found with last name ''', LastName, ''':');
  114.   with PContact(Item)^ do
  115.     writeln(LastName^, '':15 - Length(LastName^),
  116.       FirstName^, '':15 - Length(FirstName^),
  117.       Phone^, '':20 - Length(Phone^),
  118.       Company^, '':20 - Length(Company^));
  119.   ContactList^.DoneItem(Item); { not required }
  120. end;
  121.  
  122. var
  123.   ContactInfo : PSortedDoubleList;
  124.  
  125. begin
  126.   ClrScr;
  127.  
  128.   { Create the list }
  129.   ContactInfo := New(PSortedDoubleList, Init);
  130.  
  131.   { Insert items into the list }
  132.   with ContactInfo^ do
  133.   begin
  134.     Insert(New(PContact, Init('Lewis', 'Carl', '(506) 83-780',
  135.       'Running, Corp.')));
  136.     Insert(New(PContact, Init('Benton', 'Michael', '(403) 33-973',
  137.       'ER, Inc.')));
  138.     Insert(New(PContact, Init('Wagner', 'Robert', '(906) 11-230',
  139.       'Symphony, Ltd.')));
  140.     Insert(New(PContact, Init('Smith', 'John', '(656) 75-843',
  141.       'InterComm, Corp.')));
  142.   end; { with }
  143.  
  144.   DisplayContacts(ContactInfo);
  145.   Writeln;
  146.   DisplayFirst(ContactInfo);
  147.   Writeln;
  148.   DisplayLast(ContactInfo);
  149.   Writeln;
  150.   FindLastName(ContactInfo, 'Wagner');
  151.  
  152.   { Dispose of the list and all the objects in it }
  153.   Dispose(ContactInfo, Done);
  154. end.